lapply_pb <- function (X, FUN, ...)
{
  env <- environment()
  pb_Total <- length(X)
  counter <- 0
  #pb <- txtProgressBar(min = 0, max = pb_Total, style = 3)
  wrapper <- function(...) {
    curVal <- get("counter", envir = env)
    assign("counter", curVal + 1, envir = env)
    #setTxtProgressBar(get("pb", envir = env), curVal + 1)
    FUN(...)
  }
  res <- lapply(X, wrapper, ...)
  #close(pb)
  res
}

transfft <- function (sn, top = 0.3)
{
  sn.fft = fft(sn)
  qq <- length(sn) * top
  sn.fft[qq:(length(sn) - qq)] = 0 + (0+0i)
  sn.ifft = fft(sn.fft, inverse = TRUE)/length(sn.fft)
  return(Re(sn.ifft))
}

saturate <- function (y)
{
  y2 <- y
  st1 <- which(y > 8000)
  if (length(st1) > 1) {
    peak.sta <- c(1, which(diff(st1) > 12) + 1)
    peak.end <- c(which(diff(st1) > 12), length(st1))
    ini <- st1[peak.sta]
    end <- st1[peak.end]
    "%!in%" <- function(x, y) !(x %in% y)
    for (i in 1:length(ini)) {
      v1 <- ini[i]
      v2 <- end[i]
      v3 <- v1:v2
      v4 <- v3[big.peaks.col(y[v3], tre = 7000)$pos]
      heis <- y[v4]
      if (length(v4) >= 2) {
        sort.heis <- sort(heis, decreasing = TRUE)[1:2]
        v4.1 <- sort(v4[which(heis %in% sort.heis)],
                     decreasing = FALSE)
        v5b <- (v4.1[1]:(v4.1[length(v4.1)]))
        v5 <- v5b[which(v5b %!in% v4.1)]
        for (j in 1:length(v5)) {
          v6 <- v5[j]
          left <- v4.1[1]
          right <- v4.1[2]
          a <- y[left] - y[v6]
          b <- y[right] - y[v6]
          y2[v6] <- y[v6] + (2 * ((abs(a) + abs(b))/2))
        }
      } else {
        y2 <- y2
      }
    }
  } else {
    y2 <- y2
  }
  return(y2)
}

pullup <- function (mati, channel = 4)
{
  all.cols <- apply(mati[, -channel], 1, sum)
  rows <- dim(all.cols)[1]
  peak.all.cols <- big.peaks.col(all.cols, tre = 300)
  vv1 <- which(diff(peak.all.cols$pos) > 100)
  vv1 <- c(vv1, length(peak.all.cols$pos))
  vv2 <- vv1 + 1
  vv2 <- vv2[-length(vv2)]
  vv2 <- c(1, vv2)
  regions <- apply(data.frame(cbind(vv2, vv1)), 1, function(x, pos) {
    y <- pos[x[1]:x[2]]
    return(y)
  }, peak.all.cols$pos)
  for (i in 1:length(regions)) {
    maxis <- apply(mati[, -channel], 2, function(x, regi) {
      max(x[regi])
    }, regi = regions[[i]])
    ch <- c(1:length(maxis))
    wiii <- which(maxis == max(maxis))
    rest <- ch[-wiii]
    decrease <- regions[[i]][1]:(regions[[i]][length(regions[[i]])])
    mati[decrease, rest] <- mati[decrease, rest] - (mati[decrease, wiii] * 0.3)
  }
  all.inds.mats2 <- apply(mati, 2, function(x) {
    x[which(x < 0)] <- x[which(x < 0)]
    return(x)
  })
  return(all.inds.mats2)
}

big.peaks.col <- function (x, tre)
{
  r <- rle(x)
  v <- which(rep(x = diff(sign(diff(c(-Inf, r$values, -Inf)))) == -2, times = r$lengths))
  pos <- v[which(x[v] > tre)]
  hei <- x[pos]
  out <- list(pos = pos, hei = hei)
  return(out)
}

separate <- function (g, shift = 1, type = "bp")
{
  if (type == "bp") {
    vv <- which(diff(g$wei) < shift)
  } else {
    vv <- which(diff(g$pos) < shift)
  }
  vv2 <- vv + 1
  while (length(vv) > 0) {
    keep <- numeric()
    for (h in 1:length(vv)) {
      a1 <- vv[h]
      a2 <- vv2[h]
      a3 <- c(g$hei[a1], g$hei[a2])
      a4 <- c(a1, a2)
      keep[h] <- (a4[which(a3 == max(a3))])[1]
    }
    keep <- unique(keep)
    "%!in%" <- function(x, y) !(x %in% y)
    keep2 <- unique(c(vv, vv2)[which(c(vv, vv2) %!in% keep)])
    if (type == "bp") {
      g <- list(pos = g$pos[-keep2], hei = g$hei[-keep2],
                wei = g$wei[-keep2])
    } else {
      g <- list(pos = g$pos[-keep2], hei = g$hei[-keep2])
    }
    if (type == "bp") {
      vv <- which(diff(g$wei) < shift)
    } else {
      vv <- which(diff(g$pos) < shift)
    }
    vv2 <- vv + 1
  }
  return(g)
}

reals <- function (x, panel = c(100:400), shi = 1, ploidy = 2,
                   left.cond = c(0.4, 3), right.cond = 0.2, window = 0.5)
{
  neg <- which(x$wei <= 0)
  if (length(neg) > 0) {
    x <- list(pos = x$pos[-neg], hei = x$hei[-neg], wei = x$wei[-neg])
  }
  picos <- numeric()
  for (d in 1:length(x$wei)) {
    respi <- which(abs(panel - x$wei[d]) <= window)
    if (length(respi) > 0) {
      picos[d] <- 1
    } else {
      picos[d] <- 0
    }
  }
  z1 <- which(picos == 1)
  if (length(z1) > 0) {
    x2 <- list(pos = x$pos[z1], hei = x$hei[z1], wei = x$wei[z1])
    x3 <- separate(x2, shi, type = "bp")
    highest <- which(x3$hei == max(x3$hei))
    che <- x3$hei[1:highest[1]]
    ha <- which(che >= (x3$hei[highest] * left.cond[1]))
    cha <- x3$wei[1:highest[1]]
    ha2 <- unique(c(which(abs(cha - x3$wei[highest]) >= left.cond[2]), highest))
    chu <- x3$hei[highest[1]:length(x3$hei)]
    hu <- (highest[1]:length(x3$hei))[which(chu > (max(x3$hei) * right.cond))]
    ss1 <- intersect(ha, ha2)
    ha3 <- unique(c(ss1, hu))
    if (length(ha3) > 0) {
      x3 <- list(pos = x3$pos[ha3], hei = x3$hei[ha3], wei = x3$wei[ha3])
    } else {
      x3 <- x3
    }
    z2 <- length(x3$pos)
    if (z2 == 1) {
      x4 <- list(pos = rep(x3$pos, ploidy),
                 hei = rep(x3$hei, ploidy),
                 wei = rep(x3$wei, ploidy))
    }
    if (z2 > 1) {
      toget <- sort(x3$hei, decreasing = T)[1:ploidy]
      z3 <- which(x3$hei %in% toget)
      x4 <- list(pos = x3$pos[z3],
                 hei = round(x3$hei[z3]),
                 wei = x3$wei[z3])
    }
  } else {
    x4 <- list(pos = rep(0, ploidy),
               hei = rep(0, ploidy),
               wei = rep(0, ploidy))
  }
  return(x4)
}

homo.panel <- function (x, panel, window = 0.49)
{
  newxxx <- numeric()
  for (i in 1:length(x$wei)) {
    differences <- abs(x$wei[i] - panel)
    v <- which(differences < window)[1]
    if (length(v) > 0) {
      y <- panel[v]
    }
    else {
      y <- 0
    }
    newxxx[i] <- y
  }
  x$wei <- newxxx
  return(x)
}

transp <- function (col, alpha = 0.5)
{
  res <- apply(col2rgb(col), 2, function(c) rgb(c[1]/255, c[2]/255, c[3]/255, alpha))
  return(res)
}
